home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / pcpooler.arc / WEEKLY.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1980-01-01  |  27.7 KB  |  635 lines
  1. 10  REM weekly program pc-pooler:weekly file setup, updating games, data entry for picks, form printing, computations and results
  2. 11  ON ERROR GOTO 9000
  3. 12  IF O9=0 THEN ERROR 101
  4. 13  SVO9=O9:SVDT$=DT$:WKD$=DT$:SVGM$=GM$:SVLPL=LPL
  5. 14  CNF$=MID$(GM$,2,1):LIN$=LEFT$(GM$,1):TIE$=RIGHT$(GM$,1)
  6. 20  KEY OFF
  7. 21  KEY 1,"":KEY 2,"":KEY 3,"":KEY 4,"":KEY 5,"":KEY 6,"":KEY 7,"":KEY 8,"":KEY 9,"":KEY 10,""
  8. 30  PX=50:MNP=PX:TX=90:WX=100:GX=800
  9. 31  BLNK$="                                       ":BLNK2$="                    "
  10. 32  ZB$="ZZZZZZZZZZZZZZZZZZZZZ"
  11. 40  RDP=1:RDT=1:RDG=1:RDW=1:WRP=0:WRG=0:WRW=0:DIM GM%(5,WX),DT$(WX),PK%(PX,WX):DMP=0:DMT=0:DMG=0:GOSUB 360
  12. 100  CLS:PRINT"         Weekly Game File Menu":PRINT
  13. 102  KEY 1,"1":KEY 2,"2":KEY 3,"3":KEY 4,"4":KEY 5,"5":KEY 6,"6":KEY 7,"7":KEY 8,"":KEY 9,"":KEY 10,""
  14. 104  PRINT"F1- Weekly Game File Set-Up"
  15. 105  PRINT"F2- Print Weekly Game Forms"
  16. 106  PRINT"F3- Weekly Player Data Entry"
  17. 107  PRINT"F4- Weekly Game File Maintenance"
  18. 110  PRINT"F5- Weekly Point Computation"
  19. 111  PRINT"    & Printing Results"
  20. 112  PRINT"F6- Help"
  21. 113  PRINT"F7- Return to Pooler Menu"
  22. 114  PRINT
  23. 120  PRINT"Please hit F1-F7 or the appropriate":PRINT"number."
  24. 122  GOSUB 1400:MODE=VAL(C$):IF (MODE<1)OR(MODE>7) THEN 122
  25. 123  IF NG=0 AND MODE>1 AND MODE<6 THEN ERROR 204
  26. 124  ON MODE GOSUB 1000,3000,4000,6000,7000,500
  27. 125  IF MODE<7 THEN GOSUB 360:GOTO 100
  28. 130  REM check for any changes, option to avoid changing files.
  29. 131  IF WRP=0 AND WRG=0 AND WRW=0 THEN 340
  30. 132  PRINT"Press Y to approve changes made,":PRINT"or N to reject them."
  31. 133  GOSUB 1400
  32. 135  IF C$="N" THEN 340
  33. 140  IF C$<>"Y" THEN 133
  34. 150  GOSUB 450
  35. 340  O9=SVO9:DT$=SVDT$:GM$=SVGM$:LPL=SVLPL:COMMON O9,LPL,DT$,GM$:CLS:PRINT"Reading main menu...":CHAIN"pooler"
  36. 360  IF RDP=0 THEN 370:ELSE OPEN "PLAYER.DAT" FOR INPUT AS #1:INPUT#1,NP
  37. 361  IF DMP=0 THEN DIM PSTAT%(7,NP),NM$(NP),PS2%(8,NP),NM2$(NP):DMP=1
  38. 362  FOR I7=1 TO NP
  39. 364     INPUT#1,PSTAT%(1,I7),PSTAT%(2,I7),PSTAT%(3,I7),PSTAT%(4,I7),PSTAT%(5,I7),PSTAT%(6,I7),PSTAT%(7,I7),NM$(I7):NM$(I7)=LEFT$(NM$(I7)+BLNK2$,20)
  40. 365  NEXT I7
  41. 366  CLOSE#1:RDP=0
  42. 367  IF NP=0 THEN ERROR 201
  43. 370  IF RDT=0 THEN 380:ELSE OPEN "TEAMS.DAT" FOR INPUT AS #1:INPUT#1,NT
  44. 371  IF DMT=0 THEN DIM TEAM$(NT):DMT=1
  45. 372  FOR I7=1 TO NT
  46. 374  INPUT#1,TEAM$(I7)
  47. 376  NEXT I7
  48. 377  CLOSE#1:RDT=0
  49. 378  IF NT=0 THEN ERROR 202
  50. 380  IF RDG=0 THEN 400:ELSE OPEN "GAMES.DAT" FOR INPUT AS #2:INPUT#2,NG2
  51. 381  IF DMG=0 THEN DIM GM2%(5,NG2),DT2$(NG2):DMT=1
  52. 382  FOR I7=1 TO NG2
  53. 384      INPUT#2,GM2%(1,I7),GM2%(2,I7),GM2%(3,I7),GM2%(4,I7),GM2%(5,I7),DT2$(I7)
  54. 386  IF GM2%(1,I7)<1 OR GM2%(1,I7)>NT OR GM2%(2,I7)<1 OR GM2%(2,I7)>NT THEN ERROR 211
  55. 388  IF TEAM$(GM2%(1,I7))=ZB$ OR TEAM$(GM2%(2,I7))=ZB$ THEN ERROR 211
  56. 390  NEXT I7
  57. 392  CLOSE#2:RDG=0
  58. 393  IF NG2=0 THEN ERROR 203
  59. 400  IF RDW=0 THEN RETURN:ELSE WKFILE=0:OPEN "WKGAMES.DAT" FOR INPUT AS #2:INPUT#2,WKNO%,STT$,ENT$,NG,AYTD%
  60. 402  FOR I7=1 TO NG
  61. 404      INPUT#2,GM%(1,I7),GM%(2,I7),GM%(3,I7),GM%(4,I7),GM%(5,I7),DT$(I7)
  62. 406  IF GM%(1,I7)<1 OR GM%(1,I7)>NT OR GM%(2,I7)<1 OR GM%(2,I7)>NT THEN ERROR 212
  63. 408  IF TEAM$(GM%(1,I7))=ZB$ OR TEAM$(GM%(2,I7))=ZB$ THEN ERROR 212
  64. 409  FOR I8=1 TO PX:INPUT#2,PK%(I8,I7):NEXT I8
  65. 410  NEXT I7
  66. 412  CLOSE#2:WKFILE=1:RDW=0
  67. 414  RETURN
  68. 450  IF WRP=0 THEN 460:ELSE OPEN "PLAYER.DAT" FOR OUTPUT AS #1:PRINT#1,NP
  69. 452  FOR I=1 TO NP
  70. 454      PRINT#1,PSTAT%(1,I);",";PSTAT%(2,I);",";PSTAT%(3,I);",";PSTAT%(4,I);",";PSTAT%(5,I);",";PSTAT%(6,I);",";PSTAT%(7,I);",";NM$(I)
  71. 456  NEXT I
  72. 458  CLOSE#1
  73. 460  IF WRG=0 THEN 480:ELSE OPEN "GAMES.DAT" FOR OUTPUT AS #2:PRINT#2,NG2
  74. 462  FOR I7=1 TO NG2
  75. 464      PRINT#2,GM2%(1,I7);",";GM2%(2,I7);",";GM2%(3,I7);",";GM2%(4,I7);",";GM2%(5,I7);",";DT2$(I7)
  76. 470  NEXT I7
  77. 472  CLOSE#2
  78. 480  IF WRW=0 THEN RETURN:ELSE OPEN "WKGAMES.DAT" FOR OUTPUT AS #2:PRINT#2,WKNO%;",";STT$;",";ENT$;",";NG;",";AYTD%
  79. 482  FOR I7=1 TO NG
  80. 484      PRINT#2,GM%(1,I7);",";GM%(2,I7);",";GM%(3,I7);",";GM%(4,I7);",";GM%(5,I7);",";DT$(I7)
  81. 486  FOR I8=1 TO PX:PRINT#2,PK%(I8,I7):NEXT I8
  82. 490  NEXT I7
  83. 492  CLOSE#2
  84. 494  RETURN
  85. 500  CLS:PRINT"           Weekly Processing":PRINT
  86. 502  PRINT"The first step in weekly processing is":PRINT"creating a weekly game file. Select #1":PRINT"on the menu. Enter the current week #":PRINT"of your pool, then approve the dates":PRINT"for the week by entering Y. You may"
  87. 504  PRINT"then select Pro, College, Other, or":PRINT"All games for that week. At the next":PRINT"phase, all games selected are shown,":PRINT"and you may delete specific games.":PRINT
  88. 506  PRINT"When you continue to the final set-up":PRINT"phase, if you are playing a line game":PRINT"you will be prompted to enter lines if":PRINT"you know what they are at that time.":PRINT
  89. 508  PRINT"Once you set-up a weekly file, the data":PRINT"for the past week, except for point":PRINT"totals, is erased."
  90. 510  GOSUB 960
  91. 512  PRINT"Menu item #2 is to print forms with the":PRINT"games for the week, instructions for":PRINT"the pool, and special instructions":PRINT"which may be added to the form. You":PRINT"must have a printer available to use":PRINT"this option.":PRINT
  92. 514  PRINT"When you've collected some forms with":PRINT"picks, you may go into the player data":PRINT"entry (#3) section to enter them.":PRINT
  93. 516  PRINT"Item #4 is weekly game file mainten-":PRINT"ance. It is used to enter the scores":PRINT"and lines for the games of the week and":PRINT"also to make corrections. All scores":PRINT"for the week must be in before you can"
  94. 518  PRINT"run the final phase, point computation.":PRINT:GOSUB 960
  95. 520  PRINT"Item #5 calculates the total won/loss":PRINT"or points for each player for the week.":PRINT"You can then print a ranked list of all":PRINT"players by week totals. You have the":PRINT"option of rolling the weekly totals"
  96. 521  PRINT"into the YTD totals in the player file.":PRINT
  97. 522  PRINT"Don't add or delete any teams from the":PRINT"TEAMS file while they are playing in":PRINT"an active weekly file - this will make":PRINT"the weekly file invalid and you will":PRINT"have to start from scratch for the":PRINT"week."
  98. 524  PRINT:PRINT"There is help information on most sub-":PRINT"menus for weekly processing.":GOSUB 960
  99. 950  RETURN
  100. 960  LOCATE 25,1:PRINT"Hit any key to continue";:GOSUB 1400:CLS:RETURN
  101. 1000  REM wksetup program pc-pooler:setup weekly game file, delete selected games
  102. 1045  IF WKFILE=0 THEN 1080
  103. 1046  PRINT:PRINT
  104. 1050  PRINT"Before proceeding, please hit Y to let":PRINT"the last week's data be overwritten.":PRINT:PRINT"All final processing must be complete.":PRINT:PRINT"Hit any other letter to cancel.":GOSUB 1400
  105. 1060  IF C$="Y" THEN 1080
  106. 1070  PRINT:WKFILE=0:WRW=0:RDW=1:PRINT"Weekly Setup Cancelled.":GOTO 1370
  107. 1071  IF A$="H" OR A$="h" THEN GOSUB 1880:ELSE GOTO 1070
  108. 1080  CLS
  109. 1100  LOCATE 1,1:PRINT"Enter this week's number":LOCATE 3,1:PRINT"or: press enter to cancel":LOCATE 4,5:PRINT"H for Help":LOCATE 6,5:INPUT"===>";A$:WKNO%=VAL(A$):IF WKNO%=0 THEN 1071:ELSE IF (WKNO%<1)OR(WKNO%>52) THEN 1100
  110. 1105  CLS
  111. 1110  PRINT:GOSUB 2140:D$=STT$:GOSUB 1670:PRINT"Starting:";FD$;:SD$=FD$
  112. 1120  D$=ENT$:GOSUB 1670:PRINT" Ending:";FD$
  113. 1130  LOCATE 5,1:PRINT"Hit Y to accept, N to re-try, Q to quit.":GOSUB 1400
  114. 1140  IF C$="N" THEN 1080
  115. 1150  IF C$="Q" THEN 1070
  116. 1160  IF C$<>"Y" THEN 1130
  117. 1170  CLS:PRINT"Starting Date:";SD$:PRINT"Ending Date:";FD$:PRINT
  118. 1180  PRINT"Game Type Selection:":PRINT
  119. 1190  PRINT"Hit P to select Pro games only,"
  120. 1200  PRINT"    C to select College games only,"
  121. 1210  PRINT"    O to select Other games only, or"
  122. 1220  PRINT"    A to select all games."
  123. 1230  GOSUB 1400: IF (C$="A")OR(C$="P")OR(C$="C")OR(C$="O") THEN 1240:ELSE 1230
  124. 1240  CLS:PRINT"Scanning game masterfile..."
  125. 1250  NG=0
  126. 1260  FOR I7=1 TO NG2
  127. 1280     IF (DT2$(I7)<STT$)OR(DT2$(I7)>ENT$)OR(NG=WX) THEN 1310
  128. 1290     IF (LEFT$(TEAM$(GM2%(1,I7)),1)<>C$)AND(C$<>"A") THEN 1310
  129. 1300     NG=NG+1:DT$(NG)=DT2$(I7):GM%(1,NG)=GM2%(1,I7):GM%(2,NG)=GM2%(2,I7):GM%(3,NG)=GM2%(3,I7):GM%(4,NG)=GM2%(4,I7):GM%(5,NG)=GM2%(5,I7)
  130. 1301  FOR I8=1 TO PX:PK%(I8,NG)=0:NEXT I8
  131. 1310  NEXT I7
  132. 1320  IF NG=0 THEN CLS:LOCATE 7,1:PRINT"Nothing found...":GOTO 1100
  133. 1330  GOSUB 1440
  134. 1340  CHNG=0:GOSUB 1930:IF CHNG=0 THEN 1360
  135. 1350  WRG=1
  136. 1360  WRW=1:WKFILE=1:AYTD%=0
  137. 1370  RETURN:REM return to main menu
  138. 1380  REM process command string
  139. 1390  LOCATE 22,1,0,7:PRINT "Choice?=====>                       ";
  140. 1400  C$=INKEY$:IF C$="" THEN 1400
  141. 1410  IF LEN(C$)=0 THEN 1390:C$=LEFT$(C$,1)
  142. 1420  IF (ASC(C$)>=96)AND(ASC(C$)<=122) THEN C$=CHR$(ASC(C$)-32)
  143. 1430  RETURN
  144. 1440  KEY 1,"C":KEY 2,"":KEY 3,"D":KEY 4,"":KEY 5,"":KEY 6,"":KEY 7,"":KEY 8,"H":KEY 9,"B":KEY 10,"F"
  145. 1450  GTOP=1
  146. 1460  CLS:PRINT"Type/# From:";SD$;" To:";FD$;"   Line"
  147. 1470  BOT=GTOP+5:IF BOT>NG THEN BOT=NG
  148. 1480  PRINT
  149. 1490  FOR I=GTOP TO BOT
  150. 1500     PRINT LEFT$(TEAM$(GM%(1,I)),1);:PRINT USING "###";I;:PRINT".   ";RIGHT$(TEAM$(GM%(1,I)),20);"      ";
  151. 1510     IF GM%(5,I)>0 THEN PRINT USING "+##.#";(GM%(5,I)/10):ELSE PRINT
  152. 1520     PRINT "        v.s. ";RIGHT$(TEAM$(GM%(2,I)),20);" ";
  153. 1530     IF GM%(5,I)<0 THEN PRINT USING "+##.#";(ABS(GM%(5,I)/10)):ELSE PRINT
  154. 1540  PRINT
  155. 1550  NEXT I
  156. 1560  LOCATE 23,1:PRINT "F1=Continue to Next Set-Up Phase ";
  157. 1570  LOCATE 24,1:PRINT "F3=Delete F8=Help   F9=Back F10=Forward";
  158. 1580  MSG$=MSG$+BLNK$:MSG$=LEFT$(MSG$,39):LOCATE 25,1:PRINT MSG$;
  159. 1590  MSG$="Select one of the above (C to go on)"
  160. 1600  GOSUB 1380:GOLDTOP=GTOP
  161. 1610  IF C$="C" THEN CLS:RETURN
  162. 1620  IF C$="B" THEN GTOP=GTOP-5:IF GTOP<1 THEN GTOP=1:OLDTOP=-1
  163. 1630  IF C$="F" THEN GTOP=GTOP+5:IF GTOP>NG THEN GTOP=NG:OLDTOP=-1
  164. 1640  IF C$="H" THEN GOSUB 1880:C$="0"
  165. 1650  IF C$="D" THEN GOSUB 1690
  166. 1660  IF GOLDTOP<>GTOP THEN 1460:ELSE 1560
  167. 1670  REM subroutine to do formatting input d$ out fd$
  168. 1680  D1$=LEFT$(D$,2):D2$=MID$(D$,3,2):D3$=RIGHT$(D$,2):FD$=D2$+"/"+D3$+"/"+D1$:RETURN
  169. 1690  LOCATE 22,15:PRINT"Delete a game.";
  170. 1700  LOCATE 25,1:PRINT LEFT$(BLNK$,39);:LOCATE 25,1:PRINT"(Just press ENTER to cancel.)";
  171. 1710  LOCATE 24,1:PRINT LEFT$(BLNK$,39);:LOCATE 24,1:PRINT"Enter game# above. (1 -";NG;") ";
  172. 1720  LOCATE 23,1:PRINT LEFT$(BLNK$,39);:LOCATE 23,1:INPUT S$:IF LEN(S$)=0 THEN 1870: ELSE GD%=VAL(S$):IF (GD%<1)OR(GD%>NG) THEN 1720
  173. 1730  GDT$=DT$(GD%):HT$=RIGHT$(TEAM$(GM%(1,GD%)),20):VS$=RIGHT$(TEAM$(GM%(2,GD%)),20):LPTS=GM%(5,GD%)/10
  174. 1740  D$=GDT$:GOSUB 1670:LOCATE 24,1:PRINT LEFT$(BLNK$,39);:LOCATE 24,1:PRINT FD$;" ";HT$;
  175. 1750  PRINT"     ";
  176. 1760  IF LPTS>0 THEN PRINT USING "+##.#";LPTS;
  177. 1770  LOCATE 25,1:PRINT LEFT$(BLNK$,39);:LOCATE 25,1:PRINT USING "####";GD%;:PRINT ".    ";VS$;
  178. 1780  PRINT"     ";
  179. 1790  IF LPTS<0 THEN PRINT USING "+##.#";-LPTS;
  180. 1800  LOCATE 23,1:PRINT LEFT$(BLNK$,39);:LOCATE 23,1:PRINT"Hit Y to delete, N to cancel";
  181. 1810  GOSUB 1400:IF C$="N" THEN 1870:ELSE IF C$<>"Y" THEN 1810
  182. 1820  IF GD%=NG THEN 1860
  183. 1830  FOR Z=GD%+1 TO NG
  184. 1840  DT$(Z-1)=DT$(Z):GM%(1,Z-1)=GM%(1,Z):GM%(2,Z-1)=GM%(2,Z):GM%(3,Z-1)=GM%(3,Z):GM%(4,Z-1)=GM%(4,Z):GM%(5,Z-1)=GM%(5,Z)
  185. 1850  NEXT Z
  186. 1860  NG=NG-1:MSG$="Delete complete.":GOLDTOP=-1:CHNG=1:RETURN
  187. 1870  MSG$="Delete cancelled.":RETURN
  188. 1880  CLS:PRINT"            Help Information":PRINT"            Weekly Game Setup":PRINT:PRINT"This module is used to set-up a weekly":PRINT"game file.":PRINT
  189. 1890  PRINT"You narrow down the master game list by":PRINT"specifying a week number and a team":PRINT"type if desired. The weekly file is":PRINT"assembled and made available for other":PRINT"changes using the game delete option."
  190. 1900  PRINT:PRINT"You may delete any game in the subset.":PRINT"After you've examined the weekly file":PRINT"thoroughly, you may continue to the":PRINT"next phase by hitting F1 (C).":GOSUB 2370
  191. 1910  PRINT"If you`re using line values in your":PRINT"weekly game, you will be prompted for":PRINT"lines for those games that do not have":PRINT"them.":PRINT
  192. 1920  PRINT"When this cycle is complete, the weekly":PRINT"schedule will be saved on disk.":PRINT"You may update scores and lines":PRINT"in weekly game maintenance.":GOSUB 2370:GOLDTOP=-1:RETURN
  193. 1930  CHNG=0:PTR2=1:IF LIN$="N" THEN RETURN
  194. 1940  FOR Q=1 TO NG
  195. 1950     IF GM%(5,Q)<>0 THEN 2090
  196. 1960     CLS:PRINT"Home:";RIGHT$(TEAM$(GM%(1,Q)),20)
  197. 1970     PRINT"Visitor:";RIGHT$(TEAM$(GM%(2,Q)),20)
  198. 1980     PRINT:PRINT"Hit H to favor HOME,"
  199. 1990           PRINT"    V to favor VISITOR,"
  200. 2000           PRINT"    or any other letter to continue."
  201. 2010     GOSUB 1400:IF (C$<>"H")AND(C$<>"V") THEN 2090
  202. 2020     LOCATE 10,1:PRINT"By how much";:INPUT A$
  203. 2030     LV=VAL(A$):IF C$="H" THEN LV=-LV
  204. 2040     LV%=LV*10:GM%(5,Q)=LV%:FOUND=0
  205. 2050     WHILE (PTR2<=NG2)AND(FOUND=0)
  206. 2060         IF (DT$(Q)<>DT2$(PTR2))OR(GM%(1,Q)<>GM2%(1,PTR2))OR(GM%(2,Q)<>GM2%(2,PTR2))OR(GM2%(5,PTR2)=GM%(5,Q)) THEN 2070:ELSE GM2%(5,PTR2)=GM%(5,Q):CHNG=1:FOUND=1
  207. 2070         PTR2=PTR2+1
  208. 2080     WEND
  209. 2090  NEXT Q
  210. 2130  RETURN
  211. 2140  REM given wkd$ and wkno% return stt$ and ent$
  212. 2150  REM routine to compute dates given week no and start date
  213. 2160  DT$=WKD$:NDYS=(WKNO%-1)*7:IF NDYS=0 THEN STT$=WKD$:ELSE GOSUB 2180:STT$=DT2$
  214. 2170  DT$=STT$:NDYS=6:GOSUB 2180:ENT$=DT2$:RETURN
  215. 2180  REM given dt$ and ndys, return dt2$ so many days later.
  216. 2190  D1$=LEFT$(DT$,2):D2$=MID$(DT$,3,2):D3$=RIGHT$(DT$,2):D1%=VAL(D1$):D2%=VAL(D2$):D3%=VAL(D3$)
  217. 2200  Q3%=NDYS
  218. 2210  WHILE Q3%>0
  219. 2220     D3%=D3%+1: IF D3%<28 THEN 2310
  220. 2230     ON D2% GOTO 2240,2250,2240,2270,2240,2270,2240,2240,2270,2240,2270,2240
  221. 2240     ND2%=31:GOTO 2280
  222. 2250     IF D1% MOD 4 = 0 THEN ND2%=29:ELSE ND2%=28
  223. 2260     GOTO 2280
  224. 2270     ND2%=30
  225. 2280     IF D3%>ND2% THEN D3%=1:D2%=D2%+1
  226. 2290     IF D2%<13 THEN 2310
  227. 2300     D2%=1:D1%=D1%+1
  228. 2310     Q3%=Q3%-1
  229. 2320  WEND
  230. 2330  D1$=STR$(D1%):D1$=RIGHT$(D1$,LEN(D1$)-1):D1$=RIGHT$("0"+D1$,2)
  231. 2340  D2$=STR$(D2%):D2$=RIGHT$(D2$,LEN(D2$)-1):D2$=RIGHT$("0"+D2$,2)
  232. 2350  D3$=STR$(D3%):D3$=RIGHT$(D3$,LEN(D3$)-1):D3$=RIGHT$("0"+D3$,2)
  233. 2360  DT2$=D1$+D2$+D3$:RETURN
  234. 2370  LOCATE 25,1:PRINT"Hit any key to continue";:GOSUB 1400:CLS:RETURN
  235. 3000  REM wkform program pc-pooler:weekly form print of games for players
  236. 3040  CLS:PRINT"            Print Game Forms":PRINT
  237. 3050  PRINT"What date is the form due?"
  238. 3055  PRINT"(Just press ENTER to cancel)"
  239. 3060  INPUT"(MM/DD/YY)--";S$
  240. 3065  IF LEN(S$)=0 THEN 3780
  241. 3070  GOSUB 3660:IF SF$="ERROR" THEN 3090:ELSE DDUE$=S$:GOTO 3110
  242. 3080  PRINT
  243. 3090  PRINT"Invalid date - Please try again.":GOTO 3060
  244. 3110  PRINT:PRINT"There are 4 message lines."
  245. 3120  PRINT"(Up to 79 characters/line)."
  246. 3130  PRINT"Just press ENTER to skip a line.":PRINT
  247. 3135  PRINT "Enter message below:":PRINT
  248. 3140  FOR MLC=1 TO 4
  249. 3150  PRINT USING "#";MLC;
  250. 3160  INPUT Z$:IF LEN(Z$)>79 THEN Z$=LEFT$(Z$,79):PRINT"**truncated**"
  251. 3170  MSGL$(MLC)=Z$
  252. 3180  NEXT MLC
  253. 3185  MLC=4
  254. 3190  D$=STT$:GOSUB 1670:SD$=FD$:D$=ENT$:GOSUB 1670
  255. 3200  CLS:PRINT "Form Due:  ";DDUE$
  256. 3210  PRINT"Game Dates for Week";WKNO%
  257. 3220  PRINT"Start: ";SD$;" End: ";FD$:PRINT"Message lines:":PRINT
  258. 3230  FOR Q=1 TO MLC:PRINT MSGL$(Q):NEXT Q:PRINT
  259. 3240  PRINT"There are";NG;" games in the schedule.":PRINT
  260. 3250  PRINT"Please enter number of copies you want":PRINT"(Or press enter to cancel)";:INPUT C$:IF LEN(C$)>4 THEN 3250
  261. 3260  COP%=VAL(C$):IF COP%=0 THEN 3780
  262. 3270  PRINT:PRINT"Position printer to top of form":PRINT"and hit P when ready (Q to cancel)"
  263. 3280  GOSUB 1400
  264. 3290  IF C$="Q" THEN 3780
  265. 3300  IF C$<>"P" THEN 3280
  266. 3310  FOR Q=1 TO COP%
  267. 3320  LPRINT"Games for Week";WKNO%;", From ";SD$;" To ";FD$;"."
  268. 3330  LPRINT
  269. 3340  LPRINT"Name:__________________________  Number: ____ (if known)"
  270. 3350  LPRINT
  271. 3360  LPRINT"Instructions:"
  272. 3370  IF TIE$="Y" THEN LPRINT"In case of a tie, points will be awarded to both sides.":ELSE LPRINT"In case of a tie, no points will be awarded."
  273. 3380  IF CNF$="Y" THEN LPRINT"Write your confidence factor (1 -";NG;") next to your pick.":ELSE LPRINT"Put an X next to your pick."
  274. 3390  IF LIN$="Y" THEN LPRINT"Line adjustments in parens will be added to score to determine winner."
  275. 3400  LPRINT"Please turn in this form by ";DDUE$;"."
  276. 3410  LPRINT
  277. 3420  LPRINT"Messages:"
  278. 3430  LPRINT
  279. 3440  FOR I=1 TO MLC:LPRINT MSGL$(I):NEXT I
  280. 3450  LPRINT
  281. 3460  LPRINT"No. Date";TAB(19);"Home";TAB(53);"Visitor"
  282. 3470  IF LIN$="Y" THEN LPRT=18:ELSE LPRT=17
  283. 3480  FOR I=1 TO NG
  284. 3490      HT$=RIGHT$(TEAM$(GM%(1,I)),20):VT$=RIGHT$(TEAM$(GM%(2,I)),20)
  285. 3500      D$=DT$(I):GOSUB 1670
  286. 3510      LPRINT:LPRINT USING "##";I;:LPRINT ". ";FD$;TAB(14);"____ ";HT$;
  287. 3520      IF LIN$="N" THEN 3540
  288. 3530      IF GM%(5,I)>0 THEN LPRINT USING "(+##.#)";GM%(5,I)/10;
  289. 3540      LPRINT TAB(48);"____ ";VT$;
  290. 3550      IF LIN$="N" THEN 3570
  291. 3560      IF GM%(5,I)<0 THEN LPRINT USING "(+##.#)";-GM%(5,I)/10;
  292. 3570      LPRINT
  293. 3580      LPRT=LPRT+2
  294. 3590  NEXT I
  295. 3600  NLL=LPL-(LPRT MOD LPL)
  296. 3610  FOR I=1 TO NLL:LPRINT:NEXT I
  297. 3620  NEXT Q
  298. 3630  GOTO 3780
  299. 3660  REM subroutine to do date change formatted to ordered s$-sf$
  300. 3670  D1$=LEFT$(S$,2):D2$=MID$(S$,4,2):D3$=RIGHT$(S$,2):D1%=VAL(D1$):D2%=VAL(D2$):D3%=VAL(D3$)
  301. 3680  IF (D3%<1)OR(LEN(S$)<>8) THEN SF$="ERROR":RETURN
  302. 3690  IF D3% MOD 4 = 0 THEN LY%=1: ELSE LY%=0
  303. 3700  IF (D1%<1)OR(D1%>12) THEN SF$="ERROR":RETURN
  304. 3710  ON D1% GOTO 3720,3730,3720,3750,3720,3750,3720,3720,3750,3720,3750,3720
  305. 3720  NDAYS%=31:GOTO 3760
  306. 3730  IF LY%=1 THEN NDAYS%=29:ELSE NDAYS%=28
  307. 3740  GOTO 3760
  308. 3750  NDAYS%=30
  309. 3760  IF (D2%<1)OR(D2%>NDAYS%) THEN SF$="ERROR":ELSE SF$=D3$+D1$+D2$
  310. 3770  RETURN
  311. 3780  RETURN:REM return to main menu
  312. 4000  REM wkdata program pc-pooler:get weekly picks for players, print game grid.
  313. 4020  CLS
  314. 4040  IF NP=0 THEN PRINT"No player names in file.":FOR I=1 TO 1000:NEXT I:GOTO 4090
  315. 4060  CHNG=0:GOSUB 4160
  316. 4070  IF CHNG<>0 THEN WRW=1
  317. 4090  RETURN:REM return to main menu
  318. 4160  KEY 1,"Q":KEY 2,"":KEY 3,"":KEY 4,"":KEY 5,"":KEY 6,"":KEY 7,"":KEY 8,"":KEY 9,"B":KEY 10,"F"
  319. 4170  GTOP=1
  320. 4180  REM
  321. 4190  CLS:PRINT"  P#  Name     * = Data in players file":NLP=20:SPOS=GTOP:OSPOS=GTOP:PRNT=0
  322. 4200  WHILE (SPOS<=NP)AND(NLP>0)
  323. 4210      IF NM$(SPOS)=BLNK2$ THEN 4260
  324. 4220      PRINT USING "###";SPOS;:PRINT".   ";NM$(SPOS);
  325. 4230      IF PK%(SPOS,1)<>0 THEN PRINT "   *":ELSE PRINT
  326. 4240      PRNT=1
  327. 4250      NLP=NLP-1
  328. 4260      SPOS=SPOS+1
  329. 4270  WEND
  330. 4280  IF PRNT=0 THEN PRNT=1:SPOS=1:GOTO 4200
  331. 4290  LOCATE 22,1:PRINT"Enter player number or:"
  332. 4295  LOCATE 23,1:PRINT"H=Help, P=Print, Q=Quit, ";
  333. 4300  LOCATE 24,1:PRINT"B to move back, F to move forward      ";
  334. 4310  MSG$=MSG$+BLNK$:MSG$=LEFT$(MSG$,39):LOCATE 25,1:PRINT MSG$;
  335. 4320  MSG$="":GOLDTOP=GTOP
  336. 4330  LOCATE 21,1:PRINT LEFT$(BLNK$,39);:LOCATE 21,1:PRINT"Choice=====>";:INPUT C$:IF (LEN(C$)=0)OR(LEN(C$)>2)THEN 4330
  337. 4340  PI%=VAL(C$):IF PI%=0 THEN C$=LEFT$(C$,1):GOTO 4355:ELSE IF (PI%<0)OR(PI%>NP) THEN 4330
  338. 4350  IF NM$(PI%)=BLNK2$ THEN 4330:ELSE GOSUB 4480
  339. 4355  IF (ASC(C$)>=96)AND(ASC(C$)<=122) THEN C$=CHR$(ASC(C$)-32)
  340. 4360  IF C$="Q" THEN RETURN
  341. 4370  IF C$="F" THEN GTOP=SPOS-1:IF GTOP>NP THEN GTOP=NP:GOLDTOP=-1
  342. 4380  IF C$="P" THEN GOSUB 4800
  343. 4390  IF C$="B" THEN GTOP=OSPOS-19:IF GTOP<1 THEN GTOP=1:GOLDTOP=-1
  344. 4400  IF C$="H" THEN GOSUB 4440
  345. 4410  IF GOLDTOP<>GTOP THEN 4180:ELSE 4290
  346. 4440  CLS:PRINT"            Help Information":PRINT"        Weekly Player Data Entry":PRINT
  347. 4441  PRINT"This module is used to input picks from":PRINT"returned game forms.":PRINT"Enter the player number to enter/update":PRINT"his/her picks.":PRINT
  348. 4450  PRINT"You can quit when you are done with":PRINT"the data entry task by entering Q.":PRINT"You can get a hard copy of all picks":PRINT"using the print command.":PRINT"Specify number of copies."
  349. 4460  PRINT:PRINT"Help will display this help screen.":PRINT"You can use the B(Backward and":PRINT"F(forward) commands to":PRINT"look at all player names."
  350. 4470  GOSUB 2370:GOLDTOP=-1:RETURN
  351. 4480  CLS:PRINT"Data Entry For ";NM$(PI%)
  352. 4490  IF PK%(PI%,1)=0 THEN FST=1:PRINT"First Time - Must Enter All Picks":ELSE FST=0:PRINT"Update - Enter Changes Only."
  353. 4500  IF CNF$="Y" THEN CON=1:PRINT"Enter confidence factor (1 -";NG;") next":PRINT"to choice. No duplicates allowed.":ELSE CON=0:PRINT"Enter an X by your choice."
  354. 4510  PRINT"If home team isn't the pick,":PRINT"just hit ENTER to go to visitor."
  355. 4520  PRINT"Enter CLEAR to clear picks."
  356. 4530  FOR QG=1 TO NG
  357. 4540      LOCATE 12,1:PRINT BLNK$:LOCATE 12,1:PRINT USING " ##";QG;:PRINT". ";RIGHT$(TEAM$(GM%(1,QG)),20);
  358. 4550      LOCATE 13,1:PRINT BLNK$:LOCATE 13,1:PRINT"     ";RIGHT$(TEAM$(GM%(2,QG)),20);
  359. 4560      IF FST=1 THEN 4590
  360. 4570      IF PK%(PI%,QG)>0 THEN LOCATE 12,27:ELSE LOCATE 13,27
  361. 4580      IF ABS(PK%(PI%,QG))=999 THEN PRINT "X";:ELSE PRINT USING "##";ABS(PK%(PI%,QG));
  362. 4590      CV%=0:LOCATE 12,30:INPUT Q$:IF LEN(Q$)=0 THEN 4640
  363. 4600      IF (Q$="CLEAR")OR(Q$="clear") THEN 4770:ELSE IF LEN(Q$)>4 THEN 4590
  364. 4610      IF (Q$="x")OR(Q$="X") THEN CV%=999:ELSE CV%=VAL(Q$)
  365. 4620      IF CON=1 THEN 4630:ELSE IF CV%=999 THEN 4730:ELSE 4590
  366. 4630      IF (CV%<1)OR(CV%>NG) THEN 4590:ELSE 4730
  367. 4640      LOCATE 13,30:INPUT Q$:IF LEN(Q$)=0 THEN 4710
  368. 4650      IF (Q$="CLEAR")OR(Q$="clear") THEN 4770:ELSE IF LEN(Q$)>4 THEN 4640
  369. 4660      IF (Q$="X")OR(Q$="x") THEN CV%=999:ELSE CV%=VAL(Q$)
  370. 4670      IF CON=1 THEN 4680:ELSE IF CV%=999 THEN 4690:ELSE 4640
  371. 4680      IF (CV%<1)OR(CV%>NG) THEN 4640
  372. 4690      CV%=-CV%:GOTO 4730
  373. 4710      IF FST=1 THEN 4540:ELSE 4740
  374. 4730      PK%(PI%,QG)=CV%:CHNG=1
  375. 4740      FOR QC=1 TO QG-1:IF (ABS(PK%(PI%,QC))=ABS(PK%(PI%,QG)))AND(CON=1) THEN 4590:ELSE NEXT QC
  376. 4750  NEXT QG
  377. 4760  MSG$="Update complete.":GOLDTOP=-1:RETURN
  378. 4770  FOR QG=1 TO NG:PK%(PI%,QG)=0:NEXT QG:CHNG=1
  379. 4780  MSG$="Picks cleared.":GOLDTOP=-1:RETURN
  380. 4800  CLS:PRINT"          Prints Players Picks":PRINT
  381. 4810  PRINT"Please enter the number of copies,"
  382. 4820  PRINT"Or press enter to cancel."
  383. 4830  LOCATE 5,1:INPUT C$:COP%=VAL(C$):IF COP%=0 THEN 5290:ELSE IF COP%<0 THEN 4830
  384. 4840  PRINT:PRINT"Hit P when printer is ready,":PRINT"Or press enter to cancel"
  385. 4850  C$=INKEY$:IF (C$="Q")OR(C$="q") THEN 5290:ELSE IF (C$<>"P")AND(C$<>"p") THEN 4850
  386. 4860  FOR W=1 TO COP%
  387. 4870  PPOS=1
  388. 4880  WHILE PPOS<=NP
  389. 4890     PEND=PPOS+15:IF PEND>NP THEN PEND=NP
  390. 4900     LPRINT:LPRINT:LPRINT
  391. 4910     FOR MC=10 TO 1 STEP -1
  392. 4920        FOR TB=PPOS TO PEND
  393. 4930           IF MID$(NM$(TB),MC,1)<>" " THEN 4960
  394. 4940        NEXT TB
  395. 4950     NEXT MC
  396. 4960     IF MC=0 THEN MC=1
  397. 4970     FOR QP=1 TO MC
  398. 4980        LPRINT TAB(30);
  399. 4990        FOR TB=PPOS TO PEND
  400. 5000           LPRINT"| ";MID$(NM$(TB),QP,1);
  401. 5010        NEXT TB
  402. 5020       LPRINT
  403. 5030    NEXT QP:LPC=MC+3
  404. 5040    FOR QP=1 TO NG
  405. 5050       LPC=LPC+3
  406. 5060       LPRINT "*****************************";
  407. 5070       FOR TB=PPOS TO PEND:LPRINT"|**";:NEXT TB:LPRINT
  408. 5080       LPRINT USING "##";QP;:LPRINT ".";RIGHT$(TEAM$(GM%(1,QP)),20);
  409. 5090       IF LIN$="Y" THEN IF GM%(5,QP)>0 THEN LPRINT USING "+##.#";GM%(5,QP)/10;
  410. 5100       LPRINT TAB(30);
  411. 5110       FOR TB=PPOS TO PEND
  412. 5120          PICK%=PK%(TB,QP)
  413. 5130          IF PICK%<=0 THEN LPRINT"|  ";:GOTO 5150
  414. 5140          IF PICK%=999 THEN LPRINT"| X";:ELSE LPRINT USING "|##";PICK%;
  415. 5150       NEXT TB:LPRINT
  416. 5160       LPRINT"   ";RIGHT$(TEAM$(GM%(2,QP)),20);
  417. 5170       IF LIN$="Y" THEN IF GM%(5,QP)<0 THEN LPRINT USING "+##.#";-GM%(5,QP)/10;
  418. 5180       LPRINT TAB(30);
  419. 5190       FOR TB=PPOS TO PEND
  420. 5200          PICK%=PK%(TB,QP)
  421. 5210          IF PICK%=>0 THEN LPRINT"|  ";:GOTO 5230
  422. 5220          IF PICK%=-999 THEN LPRINT"| X";:ELSE LPRINT USING "|##";-PICK%;
  423. 5230       NEXT TB:LPRINT
  424. 5240    NEXT QP
  425. 5250    PPOS=PPOS+16
  426. 5260    NLL=LPL-(LPC MOD LPL):FOR ZQ4=1 TO NLL:LPRINT:NEXT ZQ4
  427. 5270  WEND
  428. 5280  NEXT
  429. 5290  GOLDTOP=-1:RETURN
  430. 6000  REM wkmaint program pc-pooler:weekly game maintenance lines/scores
  431. 6040  CHNG=0:GOSUB 6270
  432. 6050  IF CHNG=0 THEN 6200
  433. 6060  REM update games, wkgames files
  434. 6070  P=1:Q=NG2
  435. 6100  FOR J=1 TO NG
  436. 6120     FOUND=0
  437. 6130     WHILE (P<=Q)AND(FOUND=0)
  438. 6140        IF (DT$(J)<>DT2$(P))OR(GM%(1,J)<>GM2%(1,P))OR(GM%(2,J)<>GM2%(2,P)) THEN 6150:ELSE GM2%(3,P)=GM%(3,J):GM2%(4,P)=GM%(4,J):GM2%(5,P)=GM%(5,J):FOUND=1:WRG=1
  439. 6150        P=P+1
  440. 6160     WEND
  441. 6180  NEXT J
  442. 6190  WRW=1
  443. 6200  RETURN:REM return to main menu
  444. 6270  KEY 1,"Q":KEY 2,"":KEY 3,"":KEY 4,"":KEY 5,"":KEY 6,"L":KEY 7,"S":KEY 8,"H":KEY 9,"B":KEY 10,"F"
  445. 6280  GTOP=1
  446. 6290  D$=STT$:GOSUB 1670:SD$=FD$:D$=ENT$:GOSUB 1670
  447. 6300  CLS:PRINT"Type/# From:";SD$;" To:";FD$;"   Line"
  448. 6310  BOT=GTOP+5:IF BOT>NG THEN BOT=NG
  449. 6320  PRINT
  450. 6330  FOR I=GTOP TO BOT
  451. 6340     PRINT LEFT$(TEAM$(GM%(1,I)),1);:PRINT USING "###";I;:PRINT".   ";RIGHT$(TEAM$(GM%(1,I)),20);
  452. 6350     IF GM%(3,I)=-1 THEN PRINT"     ";:ELSE PRINT USING "#### ";GM%(3,I);
  453. 6360     IF GM%(5,I)>0 THEN PRINT USING "+##.#";(GM%(5,I)/10):ELSE PRINT
  454. 6370     PRINT "   v.s. ";RIGHT$(TEAM$(GM%(2,I)),20);
  455. 6380     IF GM%(4,I)=-1 THEN PRINT"     ";:ELSE PRINT USING "#### ";GM%(4,I);
  456. 6390     IF GM%(5,I)<0 THEN PRINT USING "+##.#";(ABS(GM%(5,I)/10)):ELSE PRINT
  457. 6400  PRINT
  458. 6410  NEXT I
  459. 6420  LOCATE 23,1:PRINT "F1=Quit   F6=Line Change               ";
  460. 6430  LOCATE 24,1:PRINT "F7=Score  F8=Help   F9=Back F10=Forward";
  461. 6440  MSG$=MSG$+BLNK$:MSG$=LEFT$(MSG$,39):LOCATE 25,1:PRINT MSG$;
  462. 6450  MSG$="Select one of the above (Q to Quit)"
  463. 6460  GOSUB 1380:GOLDTOP=GTOP
  464. 6470  IF C$="Q" THEN CLS:RETURN
  465. 6480  IF C$="B" THEN GTOP=GTOP-5:IF GTOP<1 THEN GTOP=1:OLDTOP=-1
  466. 6490  IF C$="F" THEN GTOP=GTOP+5:IF GTOP>NG THEN GTOP=NG:OLDTOP=-1
  467. 6500  IF C$="H" THEN GOSUB 6740:C$="0"
  468. 6510  IF C$="S" THEN GOSUB 6560
  469. 6520  IF C$="L" THEN GOSUB 6810
  470. 6530  IF GOLDTOP<>GTOP THEN 6290:ELSE 6420
  471. 6560  LOCATE 22,15:PRINT"Update a score.";
  472. 6570  LOCATE 25,1:PRINT LEFT$(BLNK$,39);:LOCATE 25,1:PRINT"(Just ENTER to cancel.)";
  473. 6580  LOCATE 24,1:PRINT LEFT$(BLNK$,39);:LOCATE 24,1:PRINT"Enter game# above. (1 -";NG;") ";
  474. 6590  LOCATE 23,1:PRINT LEFT$(BLNK$,39);:LOCATE 23,1:INPUT S$:IF (LEN(S$)=0)OR(LEN(S$)>4) THEN 6730: ELSE GD%=VAL(S$):IF (GD%<1)OR(GD%>NG) THEN 6590
  475. 6600  GDT$=DT$(GD%):HT$=RIGHT$(TEAM$(GM%(1,GD%)),20):VS$=RIGHT$(TEAM$(GM%(2,GD%)),20):LPTS=GM%(5,GD%)/10
  476. 6610  D$=GDT$:GOSUB 1670:LOCATE 24,1:PRINT LEFT$(BLNK$,39);:LOCATE 24,1:PRINT FD$;" ";HT$;
  477. 6620  IF GM%(3,GD%)=-1 THEN PRINT"     ";:ELSE PRINT USING "#### ";GM%(3,GD%);
  478. 6630  IF LPTS>0 THEN PRINT USING "+##.#";LPTS;
  479. 6640  LOCATE 25,1:PRINT LEFT$(BLNK$,39);:LOCATE 25,1:PRINT USING "####";GD%;:PRINT ".    ";VS$;
  480. 6650  IF GM%(4,GD%)=-1 THEN PRINT"     ";:ELSE PRINT USING "#### ";GM%(4,GD%);
  481. 6660  IF LPTS<0 THEN PRINT USING "+##.#";-LPTS;
  482. 6670  CHNG2=0
  483. 6680  LOCATE 23,1:PRINT LEFT$(BLNK$,39);:LOCATE 23,1:PRINT"Enter home score===>";:INPUT C$:IF (LEN(C$)=0)OR(VAL(C$)<0) THEN 6690:ELSE GM%(3,GD%)=VAL(C$):CHNG2=1
  484. 6690  LOCATE 23,1:PRINT LEFT$(BLNK$,39);:LOCATE 23,1:PRINT"Enter visitor score===>";:INPUT C$:IF (LEN(C$)=0)OR(VAL(C$)<0) THEN IF CHNG2=0 THEN 6710: ELSE 6690
  485. 6700  GM%(4,GD%)=VAL(C$):CHNG2=1
  486. 6710  IF CHNG2=1 THEN MSG$="Score changed.":GOLDTOP=-1:CHNG=1:GTOP=GD%:ELSE MSG$="Score unchanged."
  487. 6720  RETURN
  488. 6730  MSG$="Scoring cancelled.":RETURN
  489. 6740  CLS:PRINT"            Help Information":PRINT"        Weekly Game Maintenance.":PRINT
  490. 6741  RINT"This module is used to maintain the":PRINT"weekly game file.":PRINT"You may enter scores or lines.":PRINT"The data is passed to the master file.":PRINT
  491. 6750  PRINT"Briefly, F6 is used to enter a line.":PRINT"You will be prompted for the game":PRINT"number and then who is favored to win":PRINT"and by how much.":PRINT
  492. 6760  PRINT"F7 is used to enter a score.":PRINT"You will be prompted for the game":PRINT"number and then the home and visiting":PRINT"scores. Just hitting Enter will bypass":PRINT"an item.":PRINT
  493. 6770  PRINT"F8 displays this help screen,":PRINT"while F9 and F10 are used to move":PRINT"backward and forward. When you are done":PRINT"with changes, F1 will take you back":PRINT"to the main menu.";
  494. 6780  GOSUB 2370:GOLDTOP=-1:RETURN
  495. 6790  LOCATE 22,15:PRINT"Update a line.";
  496. 6800  LOCATE 25,1:PRINT LEFT$(BLNK$,39);:LOCATE 25,1:PRINT"(Just ENTER to cancel.)";
  497. 6810  LOCATE 24,1:PRINT LEFT$(BLNK$,39);:LOCATE 24,1:PRINT"Enter game# above. (1 -";NG;") ";
  498. 6820  LOCATE 23,1:PRINT LEFT$(BLNK$,39);:LOCATE 23,1:INPUT S$:IF (LEN(S$)=0)OR(LEN(S$)>3) THEN 6980: ELSE GD%=VAL(S$):IF (GD%<1)OR(GD%>NG) THEN 6820
  499. 6830  GDT$=DT$(GD%):HT$=RIGHT$(TEAM$(GM%(1,GD%)),20):VS$=RIGHT$(TEAM$(GM%(2,GD%)),20):LPTS=GM%(5,GD%)/10
  500. 6840  D$=GDT$:GOSUB 1670:LOCATE 24,1:PRINT LEFT$(BLNK$,39);:LOCATE 24,1:PRINT FD$;" ";HT$;
  501. 6850  IF GM%(3,GD%)=-1 THEN PRINT"     ";:ELSE PRINT USING "#### ";GM%(3,GD%);
  502. 6860  IF LPTS>0 THEN PRINT USING "+##.#";LPTS;
  503. 6870  LOCATE 25,1:PRINT LEFT$(BLNK$,39);:LOCATE 25,1:PRINT USING "####";GD%;:PRINT ".    ";VS$;
  504. 6880  IF GM%(4,GD%)=-1 THEN PRINT"     ";:ELSE PRINT USING "#### ";GM%(4,GD%);
  505. 6890  IF LPTS<0 THEN PRINT USING "+##.#";-LPTS;
  506. 6900  LOCATE 23,1:PRINT LEFT$(BLNK$,39);:LOCATE 23,1:PRINT"Hit H=Home,V=Visit,N=None,C=Cancel";
  507. 6910  GOSUB 1400:IF C$="C" THEN 6980:ELSE IF C$="N" THEN 6970:ELSE IF (C$<>"H")AND(C$<>"V") THEN 6910
  508. 6920  LOCATE 23,1:PRINT LEFT$(BLNK$,39);:LOCATE 23,1:PRINT"By how much";:INPUT A$:IF LEN(A$)=0 THEN 6980:ELSE LV=VAL(A$):IF LV<0 THEN 6920
  509. 6930  IF C$="H" THEN LV=-LV
  510. 6940  GM%(5,GD%)=LV*10:MSG$="Line changed.":GOLDTOP=-1:GTOP=GD%:CHNG=1:RETURN
  511. 6950  IF CHNG2=1 THEN MSG$="Score changed.":GOLDTOP=-1:CHNG=1:GTOP=GD%:ELSE MSG$="Score unchanged."
  512. 6960  RETURN
  513. 6970  GM%(5,GD%)=0:MSG$="Line removed.":GOLDTOP=-1:CHNG=1:GTOP=GD%:RETURN
  514. 6980  MSG$="Line change cancelled.":RETURN
  515. 7000  REM wkcomp program pc-pooler:weekly computation of points, ranked listing
  516. 7010  FOR Q=1 TO NG
  517. 7020  IF (GM%(2,Q)=-1)OR(GM%(3,Q)=-1) THEN PRINT:PRINT"Games not complete.":GOSUB 9550:GOTO 7200
  518. 7030  NEXT Q
  519. 7060  CLS:PRINT"Calculating results...":GOSUB 7300
  520. 7070  GOSUB 7630
  521. 7080  PRINT"Hit Q - Quit/Abandon Results":PRINT"        (return to main menu)":PRINT
  522. 7090  PRINT"    C - Continue Printing Results":PRINT
  523. 7095  IF AYTD%<>0 THEN 7120
  524. 7100  PRINT"    D - Done with weekly file.":PRINT"        Roll weekly totals "
  525. 7110  PRINT"        into YTD totals and mark":PRINT"        the weekly file as done."
  526. 7120  PRINT
  527. 7130  GOSUB 1400:IF C$="Q" THEN 7200:ELSE IF C$="C" THEN 7070:ELSE IF (C$<>"D")OR(AYTD%<>0) THEN 7130
  528. 7140  PRINT:PRINT "Verify to save results":PRINT"in YTD player file.":PRINT
  529. 7150  PRINT "Hit Y or N please..."
  530. 7160  GOSUB 1400
  531. 7170  IF C$="N" THEN 7200:ELSE IF C$<>"Y" THEN 7160
  532. 7180  WRW=1:AYTD%=1
  533. 7190  WRP=1
  534. 7200  RETURN:REM return to main menu
  535. 7300  REM calculation of weekly points
  536. 7310  FOR Q= 1 TO NG
  537. 7320  IF LIN$="Y" THEN COMP%=SGN(GM%(3,Q)+(GM%(5,Q)/10)-GM%(4,Q)):ELSE COMP%=SGN(GM%(3,Q)-GM%(4,Q))
  538. 7330  FOR P= 1 TO NP
  539. 7340     IF PK%(P,1)=0 THEN 7410
  540. 7350     PLCMP%=SGN(PK%(P,Q))
  541. 7360     WTL%=COMP%*PLCMP%
  542. 7370     IF TIE$="Y" THEN WTL%=WTL%+1
  543. 7380     IF WTL%<1 THEN 7410
  544. 7390     IF CNF$="Y" THEN PSTAT%(5,P)=PSTAT%(5,P)+ABS(PK%(P,Q))
  545. 7400     PSTAT%(6,P)=PSTAT%(6,P)+1
  546. 7410  NEXT P
  547. 7420  NEXT Q
  548. 7430  FOR P=1 TO NP
  549. 7440    IF PK%(P,1)=0 THEN 7500
  550. 7450    PSTAT%(7,P)=NG-PSTAT%(6,P)
  551. 7460    PSTAT%(2,P)=PSTAT%(2,P)+PSTAT%(5,P)
  552. 7470    PSTAT%(3,P)=PSTAT%(3,P)+PSTAT%(6,P)
  553. 7480    PSTAT%(4,P)=PSTAT%(4,P)+PSTAT%(7,P)
  554. 7490    PSTAT%(1,P)=PSTAT%(1,P)+1
  555. 7500  NEXT P
  556. 7510  RETURN
  557. 7630  REM printthe list...no selection...option to sort on y-t-d record
  558. 7640  CLS:PRINT"             Player Listing":PRINT
  559. 7650  NP2=0
  560. 7660  FOR Z2=1 TO NP:IF NM$(Z2)=BLNK2$ THEN 7690
  561. 7670  NP2=NP2+1:NM2$(NP2)=NM$(Z2):PS2%(1,NP2)=PSTAT%(1,Z2):PS2%(2,NP2)=PSTAT%(2,Z2):PS2%(3,NP2)=PSTAT%(3,Z2):PS2%(4,NP2)=PSTAT%(4,Z2):PS2%(5,NP2)=Z2
  562. 7680  PS2%(6,NP2)=PSTAT%(5,Z2):PS2%(7,NP2)=PSTAT%(6,Z2):PS2%(8,NP2)=PSTAT%(7,Z2)
  563. 7690  NEXT Z2
  564. 7700  PRINT"Do you want the output sorted":IF CNF$="Y" THEN PRINT "by weekly confidence points?":ELSE PRINT"by weekly games won?"
  565. 7710  PRINT:PRINT"Hit Y to sort, or N to leave":PRINT"in player # order.":PRINT
  566. 7720  GOSUB 1400:IF C$="N" THEN PRINT"Unsorted...":GOTO 7850:ELSE IF C$<>"Y" THEN 7720
  567. 7730  PRINT"Sorting..."
  568. 7740  IF CNF$="Y" THEN STKEY=6:ELSE STKEY=7
  569. 7750  FOR S1=1 TO NP2-1
  570. 7760      MXV=PS2%(STKEY,S1):MXP=S1
  571. 7770      FOR S2=S1+1 TO NP2
  572. 7780          IF PS2%(STKEY,S2)<=MXV THEN 7800
  573. 7790          MXV=PS2%(STKEY,S2):MXP=S2
  574. 7800      NEXT S2
  575. 7810      IF MXP=S1 THEN 7840:ELSE S2=MXP
  576. 7820      SWAP PS2%(1,S2),PS2%(1,S1):SWAP PS2%(2,S2),PS2%(2,S1):SWAP PS2%(3,S2),PS2%(3,S1):SWAP PS2%(4,S2),PS2%(4,S1):SWAP PS2%(5,S2),PS2%(5,S1):SWAP NM2$(S2),NM2$(S1)
  577. 7830      SWAP PS2%(6,S2),PS2%(6,S1):SWAP PS2%(7,S2),PS2%(7,S1):SWAP PS2%(8,S2),PS2%(8,S1)
  578. 7840  NEXT S1
  579. 7850  SRT$=C$:PRINT:PRINT"Enter number of copies below,":PRINT"Or press enter to cancel print."
  580. 7860  INPUT A$:CPYS%=VAL(A$):IF CPYS%<1 THEN 8120
  581. 7870  PRINT:PRINT"Hit P when printer ready,":PRINT"Or Q to cancel print."
  582. 7880  GOSUB 1400:IF C$="Q" THEN 8120:ELSE IF C$<>"P" THEN 7880
  583. 7890  REM
  584. 7900  FOR ZQ3=1 TO CPYS%
  585. 7910  LPRINT:LPRINT:LPRINT:LPRINT"Player List ";
  586. 7920  IF SRT$="N" THEN LPRINT:GOTO 7940
  587. 7930  LPRINT"- Sorted By ";:IF STKEY=6 THEN LPRINT"Weekly Points":ELSE LPRINT"Weekly Games Won"
  588. 7940  LPRINT
  589. 7950  LPRINT"No.";TAB(5);"Player";TAB(25);"Weeks";TAB(33);"Week";TAB(39);"Week";TAB(45);"Week";TAB(52);"Y-T-D";TAB(59);"Y-T-D";TAB(65);"Y-T-D"
  590. 7960  LPRINT TAB(5);"Name";TAB(25);"Played";TAB(32);"Points";TAB(40);"Won";TAB(45);"Lost";TAB(52);"Points";TAB(60);"Won";TAB(65);"Lost"
  591. 7970  LPRINT
  592. 7980  FOR Z2=1 TO NP2
  593. 7990      LPRINT USING "##";PS2%(5,Z2);:LPRINT".";
  594. 8000      LPRINT TAB(5);NM2$(Z2);TAB(26);
  595. 8010      IF PS2%(1,Z2)=0 THEN LPRINT"---";:ELSE LPRINT USING "###";PS2%(1,Z2);
  596. 8020      LPRINT TAB(33);:LPRINT USING "####";PS2%(6,Z2);
  597. 8030      LPRINT TAB(40);:LPRINT USING "###";PS2%(7,Z2);
  598. 8040      LPRINT TAB(46);:LPRINT USING "###";PS2%(8,Z2);
  599. 8050      LPRINT TAB(53);:LPRINT USING "####";PS2%(2,Z2);
  600. 8060      LPRINT TAB(60);:LPRINT USING "###";PS2%(3,Z2);
  601. 8070      LPRINT TAB(66);:LPRINT USING "###";PS2%(4,Z2)
  602. 8080  NEXT Z2
  603. 8090  NLL=LPL-((NP2+8) MOD LPL)
  604. 8100  FOR ZQ2=1 TO NLL:LPRINT:NEXT ZQ2
  605. 8110  NEXT ZQ3
  606. 8120  CLS:RETURN
  607. 9000  PRINT:IF ERL=400 AND ERR=53 THEN WKFILE=0:NG=0:RDW=0:RESUME 414
  608. 9010  IF ERR=101 THEN PRINT"You must access this program through":PRINT"the POOLER program.":GOSUB 9550:SYSTEM
  609. 9020  IF ERR=24 OR ERR=62 OR ERR=71 OR ERR=72 THEN 9022:ELSE 9030
  610. 9022  PRINT"Error accessing logged drive.":GOSUB 9800:IF C$="R" THEN RESUME:ELSE SYSTEM
  611. 9030  IF ERR=53 THEN 9032:ELSE 9050
  612. 9032  IF ERL=360 THEN 9034:ELSE 9036
  613. 9034  PRINT"Player file not found...":GOSUB 9550:RESUME 340
  614. 9036  IF ERL=370 THEN 9038:ELSE 9040
  615. 9038  PRINT"Team file not found...":GOSUB 9550:RESUME 340
  616. 9040  IF ERL=380 THEN 9042:ELSE 9050
  617. 9042  PRINT"Master game file not found...":GOSUB 9550:RESUME 340
  618. 9050  IF ERR=70 THEN PRINT"Disk write protected.":GOSUB 9800:IF C$="R" THEN RESUME:ELSE RESUME 340
  619. 9052  IF ERR=25 OR ERR=27 THEN 9053:ELSE 9060
  620. 9053  PRINT"Print error... check printer.":GOSUB 9800:IF C$="R" THEN RESUME
  621. 9054  IF ERL>=3320 AND ERL<=3610 THEN RESUME 3780
  622. 9055  IF ERL>=4860 AND ERL<=5290 THEN RESUME 5290
  623. 9056  IF ERL>=7810 AND ERL<=8110 THEN RESUME 8120
  624. 9057  SYSTEM
  625. 9060  IF ERR=201 THEN PRINT"Zero players in file...":GOSUB 9550:RESUME 340
  626. 9070  IF ERR=202 THEN PRINT"No teams in team file.":GOSUB 9550:RESUME 340
  627. 9080  IF ERR=203 THEN PRINT"No games in game file.":GOSUB 9550:RESUME 340
  628. 9090  IF ERR=204 THEN PRINT"Can't do that before setting up a":PRINT"weekly game file.":GOSUB 9550:RESUME 100
  629. 9100  IF ERR=211 THEN PRINT"Invalid team # in master game file.":GOSUB 9550:RESUME 340
  630. 9110  IF ERR=212 THEN PRINT"Invalid team # in weekly game file.":GOSUB 9550:RESUME 340
  631. 9500  ON ERROR GOTO 0
  632. 9550  FOR I9=1 TO 400:I8=I9+3:NEXT I9:RETURN
  633. 9800  PRINT"Press R to Retry,":PRINT"or Q to quit.":GOSUB 1400:IF C$<>"R" AND C$<>"Q" THEN 9800
  634. 9810  RETURN
  635.